﻿' ----------------------------------------------------------------------------------
' Microsoft Developer & Platform Evangelism
' 
' Copyright (c) Microsoft Corporation. All rights reserved.
' 
' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, 
' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES 
' OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ----------------------------------------------------------------------------------
' The example companies, organizations, products, domain names,
' e-mail addresses, logos, people, places, and events depicted
' herein are fictitious.  No association with any real company,
' organization, product, domain name, email address, logo, person,
' places, or events is intended or should be inferred.
' ----------------------------------------------------------------------------------

Imports System.Data.Services.Client
Imports System.Globalization
Imports System.Net
Imports System.Security.Cryptography
Imports System.Text

Namespace Credentials

    Public Class StorageCredentialsAccountAndKey
        Implements IStorageCredentials

        Private accountName As String
        Private accountKey() As Byte

        Public Sub New(ByVal accountName As String, ByVal accountKey As String)
            If String.IsNullOrEmpty(accountName) Then
                Throw New ArgumentException("The account name cannot be empty", "accountName")
            End If

            If String.IsNullOrEmpty(accountKey) Then
                Throw New ArgumentException("The account key cannot be empty", "accountKey")
            End If

            Me.accountName = accountName
            Me.accountKey = Convert.FromBase64String(accountKey.ToString())
        End Sub

        Public Sub SignRequest(ByVal webRequest As WebRequest, ByVal contentLength As Long) Implements IStorageCredentials.SignRequest
            If webRequest IsNot Nothing Then
                webRequest.Headers("x-ms-date") = Me.GetDateHeader()
                webRequest.Headers("Authorization") = GetAuthenticationHeader(webRequest, contentLength, Me.accountName, Me.accountKey)
            End If
        End Sub

        Public Sub SignRequestLite(ByVal webRequest As WebRequest) Implements IStorageCredentials.SignRequestLite
            If webRequest IsNot Nothing Then
                Me.AddAuthenticationHeadersLite(New RequestData With {.Method = webRequest.Method, .RequestUri = webRequest.RequestUri}, webRequest.Headers)
            End If
        End Sub

        Public Sub AddAuthenticationHeadersLite(ByVal requestData As RequestData, ByVal requestHeaders As WebHeaderCollection) Implements IStorageCredentials.AddAuthenticationHeadersLite
            If requestHeaders IsNot Nothing Then
                Dim xmsdate = Me.GetDateHeader()
                requestHeaders("x-ms-version") = "2009-09-19"
                requestHeaders("x-ms-date") = xmsdate
                requestHeaders("Authorization") = GetAuthenticationHeaderLite(requestData, Me.accountName, Me.accountKey, xmsdate)
            End If
        End Sub

        Friend Overridable Function GetDateHeader() As String
            Return Date.UtcNow.ToString("R", CultureInfo.InvariantCulture)
        End Function

        Private Shared Function GetCanonicalizedResourceVersion2(ByVal address As Uri, ByVal accountName As String) As String
            Dim builder = New StringBuilder("/")
            builder.Append(accountName)
            builder.Append(address.AbsolutePath)

            Dim canonicalizedString = New CanonicalizedString(builder.ToString())
            Dim values = HttpUtility.ParseQueryString(address.Query)
            Dim allValues = New WebHeaderCollection()
            For Each key As String In values.AllKeys
                Dim list = New List(Of String)(values.GetValues(key))
                list.Sort()

                Dim innerBuilder = New StringBuilder()
                For Each obj2 As Object In list
                    If innerBuilder.Length > 0 Then
                        innerBuilder.Append(",")
                    End If

                    innerBuilder.Append(obj2.ToString())
                Next obj2

                allValues.Add(If(String.IsNullOrEmpty(key), key, key.ToLowerInvariant()), innerBuilder.ToString())
            Next key

            Dim keyList = New List(Of String)(allValues.AllKeys)
            keyList.Sort()

            For Each key As String In keyList
                Dim innerBuilder = New StringBuilder(String.Empty)
                innerBuilder.Append(key)
                innerBuilder.Append(":")
                innerBuilder.Append(allValues(key))
                canonicalizedString.AppendCanonicalizedElement(innerBuilder.ToString())
            Next key

            Return canonicalizedString.Value
        End Function

        Private Shared Function GetStandardHeaderValue(ByVal headers As WebHeaderCollection, ByVal headerName As String) As String
            Dim headerValues = GetHeaderValues(headers, headerName)
            If headerValues.Count <> 1 Then
                Return String.Empty
            End If

            Return CStr(headerValues(0))
        End Function

        Private Shared Function GetHeaderValues(ByVal headers As WebHeaderCollection, ByVal headerName As String) As List(Of String)
            Dim list = New List(Of String)()
            Dim values = headers.GetValues(headerName)
            If values IsNot Nothing Then
                For Each value As String In values
                    list.Add(value.TrimStart(New Char() {}))
                Next value
            End If

            Return list
        End Function

        Private Shared Function CanonicalizeHttpRequest(ByVal accountName As String, ByVal contentLength As Long, ByVal webRequest As WebRequest) As String
            Dim canonicalizedString = New CanonicalizedString(webRequest.Method)
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "Content-Encoding"))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "Content-Language"))
            canonicalizedString.AppendCanonicalizedElement(If(contentLength = -1L, String.Empty, contentLength.ToString(CultureInfo.InvariantCulture)))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "Content-MD5"))
            canonicalizedString.AppendCanonicalizedElement(webRequest.ContentType)
            canonicalizedString.AppendCanonicalizedElement(If((Not String.IsNullOrEmpty(GetStandardHeaderValue(webRequest.Headers, "x-ms-date"))), String.Empty, GetStandardHeaderValue(webRequest.Headers, "Date")))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "If-Modified-Since"))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "If-Match"))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "If-None-Match"))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "If-Unmodified-Since"))
            canonicalizedString.AppendCanonicalizedElement(GetStandardHeaderValue(webRequest.Headers, "Range"))
            AddCanonicalizedHeaders(webRequest.Headers, canonicalizedString)
            AddCanonicalizedResourceVersion2(webRequest.RequestUri, accountName, canonicalizedString)
            Return canonicalizedString.Value
        End Function

        Private Shared Sub AddCanonicalizedResourceVersion2(ByVal address As Uri, ByVal accountName As String, ByVal canonicalizedString As CanonicalizedString)
            Dim element = GetCanonicalizedResourceVersion2(address, accountName)

            canonicalizedString.AppendCanonicalizedElement(element)
        End Sub

        Private Shared Sub AddCanonicalizedHeaders(ByVal headers As WebHeaderCollection, ByVal canonicalizedString As CanonicalizedString)
            Dim keyList = New List(Of String)()
            For Each key As String In headers.AllKeys
                If key.ToLowerInvariant().StartsWith("x-ms-", StringComparison.Ordinal) Then
                    keyList.Add(key.ToLowerInvariant())
                End If
            Next key

            keyList.Sort()
            For Each key As String In keyList
                Dim builder = New StringBuilder(key)
                Dim colonAndComma = ":"
                For Each values As String In GetHeaderValues(headers, key)
                    Dim value As String = values.Replace(vbCrLf, String.Empty)
                    builder.Append(colonAndComma)
                    builder.Append(value)
                    colonAndComma = ","
                Next values

                canonicalizedString.AppendCanonicalizedElement(builder.ToString())
            Next key
        End Sub

        Private Shared Function ComputeMacSha256(ByVal accountKey() As Byte, ByVal canonicalizedString As String) As String
            Dim bytes = Encoding.UTF8.GetBytes(canonicalizedString)
            Using hmacsha = New HMACSHA256(accountKey)
                Return Convert.ToBase64String(hmacsha.ComputeHash(bytes))
            End Using
        End Function

        Private Shared Function CanonicalizeHttpRequestLite(ByVal accountName As String, ByVal xmsdate As String, ByVal requestUri As Uri) As String
            If String.IsNullOrEmpty(xmsdate) Then
                Throw New ArgumentException(String.Format(CultureInfo.CurrentCulture, "Canonicalization did not find a non empty x-ms-date header in the WebRequest. Please use a WebRequest with a valid x-ms-date header in RFC 123 format (example request.Headers(""x-ms-date"") = Date.UtcNow.ToString(""R"", CultureInfo.InvariantCulture))", New Object() {}), "xmsdate")
            End If

            Dim canonicalizedString = New CanonicalizedString(xmsdate)
            canonicalizedString.AppendCanonicalizedElement(GetCanonicalizedResourceLite(requestUri, accountName))

            Return canonicalizedString.Value
        End Function

        Private Shared Function GetCanonicalizedResourceLite(ByVal address As Uri, ByVal accountName As String) As String
            Dim builder = New StringBuilder("/")
            builder.Append(accountName)
            builder.Append(address.AbsolutePath)

            Dim parsedQuery = HttpUtility.ParseQueryString(address.Query)
            Dim compQuery = If(parsedQuery("comp") IsNot Nothing, parsedQuery("comp"), String.Empty)
            If Not String.IsNullOrEmpty(compQuery) Then
                builder.Append("?comp=")
                builder.Append(compQuery)
            End If

            Return builder.ToString()
        End Function

        Private Shared Function GetAuthenticationHeader(ByVal webRequest As WebRequest, ByVal contentLength As Long, ByVal accountName As String, ByVal accountKey() As Byte) As String
            Dim canonicalizedString = CanonicalizeHttpRequest(accountName, contentLength, webRequest)
            Dim hmacsha256 = ComputeMacSha256(accountKey, canonicalizedString)

            Return String.Format(CultureInfo.InvariantCulture, "SharedKey {0}:{1}", accountName, hmacsha256)
        End Function

        Private Shared Function GetAuthenticationHeaderLite(ByVal requestData As RequestData, ByVal accountName As String, ByVal accountKey() As Byte, ByVal xmsdate As String) As String
            Dim canonicalizedString = CanonicalizeHttpRequestLite(accountName, xmsdate, requestData.RequestUri)
            Dim hmacsha256 = ComputeMacSha256(accountKey, canonicalizedString)

            Return String.Format(CultureInfo.InvariantCulture, "SharedKeyLite {0}:{1}", accountName, hmacsha256)
        End Function

    End Class

End Namespace